home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / pcword.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-04-24  |  3.4 KB  |  77 lines
  1. 2  REM *** 1011PCWORD - WORD PUZZLE GENERATOR FOR IBM PC ***
  2. 3  REM *** DO NOT RENUMBER ON VSPC... ***
  3. 5  REM *** BE SURE TO SET LINESIZE 250 BEFORE DOWNLOAD ***
  4. 6  REM === NOTE ROUTINE AT 680 PRINTS Y ACROSS, X DOWN. ===
  5. 10  REM WORD SEARCH PUZZLE FROM SOFTSIDE # 38 PP 56-57.
  6. 20  REM
  7. 30  DEF FNU$(A$)=CHR$(ASC(A$+" ")+32*(A$>="a" AND A$<="z"))
  8. 100  KEY OFF:WIDTH 40:CLS:LOCATE 10,9,0:PRINT"WORD SEARCH PUZZLE GENERATOR":LOCATE 12,14,0:PRINT"BY DAVID W. DURKEE":LOCATE 14,14,0:PRINT"COPYRIGHT(C) 1981":LOCATE 20,11:PRINT"PC VERSION BY FRED CONDO"
  9. 101  REM
  10. 102  REM
  11. 110  FOR I=1 TO 2500:NEXT I:LOCATE,,1:OPEN"SCRN:" FOR OUTPUT AS #1:OPEN"LPT1:" FOR OUTPUT AS #2:CPF=1
  12. 115  REM
  13. 120  CLS:LOCATE 10:PRINT #CPF,"TO CREATE A PUZZLE, SIMPLY ENTER A WORD YOU WOULD LIKE TO HAVE IN THE PUZZLE    AFTER THE '?' PROMPT."
  14. 125  REM
  15. 130  LOCATE 14:PRINT #CPF,"WHEN YOU'VE ENTERED ALL THE WORDS YOU   WOULD LIKE IN THE PUZZLE, TYPE 'STOP'   AND THE PC WILL DO THE REST."
  16. 135  REM
  17. 140  LOCATE 18:PRINT #CPF,"IF YOU WOULD LIKE TO MAKE A PUZZLE FOR  YOURSELF (BLANK SCREEN), THEN TYPE '1'; OTHERWISE TYPE '0' TO BEGIN: ";
  18. 150  INPUT BLANK:IF BLANK=1 THEN BLANK=-1 ELSE IF BLANK<>0 THEN 140
  19. 155  CLS:Z=0
  20. 160  DIM W$(200),B%(3,3),A%(40,20)
  21. 165  REM --- BEGINNING OF WORD-ENTRY LOOP. ---
  22. 170  Z=Z+1
  23. 180  LOCATE 22,1:PRINT #CPF,SPACE$(40);:LOCATE 22,1:PRINT #CPF,"WORD #";STR$(Z);:LINE INPUT"? ";A$:IF A$="" THEN 180
  24. 185  REM
  25. 190  TMP$="":FOR CHAR=1 TO LEN(A$):TMP$=TMP$+FNU$(MID$(A$,CHAR,1)):NEXT CHAR:IF TMP$="STOP" THEN 530
  26. 195  REM
  27. 200  W$(Z)=A$
  28. 205  REM --- CHOOSE RANDOM STARTING POSITION, THEN CHECK EACH DIRECTION TO
  29. 206  REM --- SEE IF THE WORD WILL FIT THAT WAY.
  30. 210  U=INT(RND(1)*20)+1:L=INT(RND(1)*40)+1:FOR X=-1 TO 1:FOR Y=-1 TO 1:IF X=Y AND Y=0 THEN 330
  31. 240  X1=L:Y1=U:FOR C=1 TO LEN(A$):X1=X1+X:Y1=Y1+Y:IF X1>40 OR X1<1 OR Y1>20 OR Y1<1 THEN B%(X+2,Y+2)=0:GOTO 330
  32. 280  IF A%(X1,Y1)=0 THEN 310
  33. 290  IF A%(X1,Y1)<>ASC(MID$(A$,C,1)) THEN B%(X+2,Y+2)=0:GOTO 330
  34. 300  B%(X+2,Y+2)=B%(X+2,Y+2)+1
  35. 310  NEXT C
  36. 320  B%(X+2,Y+2)=B%(X+2,Y+2)+1:B=B+1
  37. 330  NEXT Y:NEXT X:IF B=0 THEN 210
  38. 345  REM --- SELECT THE DIRECTION TO WRITE THE WORD:
  39. 346  REM --- IF POSSIBLE, CHOOSE ONE THAT INTERSECTS ANOTHER WORD.
  40. 350  R=2:D=2:FOR X=1 TO 3:FOR Y=1 TO 3:IF B%(X,Y)>B%(R,D) THEN R=X:D=Y
  41. 380  NEXT Y:NEXT X:X=R-2:Y=D-2:IF X=-1 AND Y=-1 AND B%(1,1)=1 THEN 420
  42. 410  GOTO 440
  43. 420  X=INT(RND(1)*3)-1:Y=INT(RND(1)*3)-1
  44. 430  IF(X=0 AND Y=0) OR B%(X+2,Y+2)=0 THEN 420
  45. 435  REM --- PRINT WORD ON SCREEN, UNLESS USER CHOSE BLANK SCREEN.
  46. 440  X1=L:Y1=U:FOR C=1 TO LEN(A$):X1=X1+X:Y1=Y1+Y:A%(X1,Y1)=ASC(MID$(A$,C,1)):IF BLANK THEN 500
  47. 490  LOCATE Y1,X1:PRINT #CPF,CHR$(A%(X1,Y1));
  48. 500  NEXT C
  49. 510  B=0:FOR X=1 TO 3:FOR Y=1 TO 3:B%(X,Y)=0:NEXT Y:NEXT X:LOCATE 22,1:PRINT #CPF,SPC(39);:GOTO 170
  50. 525  REM --- PREPARE THE ANSWER KEY ---
  51. 530  FOR X=1 TO 40:FOR Y=1 TO 20:IF A%(X,Y)<>0 THEN 560
  52. 550  A%(X,Y)=45:LOCATE Y,X:PRINT #CPF,"-";
  53. 560  NEXT Y:NEXT X
  54. 570  LOCATE 22:LINE INPUT"READY TO PRINT. TURN ON PRINTER AND HIT <RETURN>...";A$:CPF=2:GOSUB 680
  55. 573  REM
  56. 575  REM --- FILL IN THE BLANKS WITH RANDOM LETTERS ---
  57. 580  PRINT #CPF,:PRINT #CPF,"WORD PUZZLE ANSWER KEY":PRINT #CPF,CHR$(12);:CPF=1:PRINT #CPF,:PRINT #CPF,"PLEASE WAIT A MINUTE FOR ME TO CREATE   PUZZLE...":CPF=2:FOR X=1 TO 40:FOR Y=1 TO 20:IF A%(X,Y)<>45 THEN 640
  58. 620  REM
  59. 621  REM
  60. 630  B=INT(RND(1)*26)+65:IF RND(1)<0.5 THEN A%(X,Y)=B ELSE A%(X,Y)=B+32
  61. 640  NEXT Y:NEXT X
  62. 650  GOSUB 680:PRINT #CPF,:PRINT #CPF,"COMPUTER GENERATED WORD PUZZLE"
  63. 670  PRINT #CPF,CHR$(12);:GOTO 730
  64. 675  REM --- SUBROUTINE TO PRINT THE COMPLETE PUZZLE ---
  65. 680  PRINT #CPF,:FOR X=1 TO 40:FOR Y=1 TO 20:PRINT #CPF,CHR$(A%(X,Y));" ";:NEXT Y:PRINT #CPF,:NEXT X
  66. 710  REM
  67. 720  RETURN
  68. 725  REM --- ALPHABETIZE AND PRINT OUT THE WORD LIST ---
  69. 730  PRINT #CPF,"WORD LIST":PRINT #CPF,:FOR Z7=1 TO Z-2:PTR=Z7:FOR Z8=Z7+1 TO Z-1:IF W$(Z8)<W$(PTR) THEN PTR=Z8
  70. 735  REM
  71. 750  NEXT Z8:SWAP W$(Z7),W$(PTR):NEXT Z7
  72. 760  FOR I=1 TO Z-1:PRINT #CPF,W$(I):NEXT I
  73. 765  REM --- ANOTHER COPY?  IF NOT, THEN END ---
  74. 770  CPF=1:PRINT #CPF,:LINE INPUT"WOULD YOU LIKE ANOTHER COPY? ";A$:IF FNU$(A$)="Y" THEN CPF=2:PRINT #CPF,CHR$(12):GOTO 650
  75. 780  REM
  76. 790  CLOSE:WIDTH 80:KEY ON:END
  77.